home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Surface2.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-22  |  12KB  |  406 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSurface2 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Surface2"
  6.    ClientHeight    =   5295
  7.    ClientLeft      =   300
  8.    ClientTop       =   570
  9.    ClientWidth     =   9135
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   5295
  24.    ScaleWidth      =   9135
  25.    Begin VB.OptionButton optSurface 
  26.       Caption         =   "Volcano"
  27.       Height          =   255
  28.       Index           =   13
  29.       Left            =   0
  30.       TabIndex        =   14
  31.       Top             =   4680
  32.       Width           =   2055
  33.    End
  34.    Begin VB.OptionButton optSurface 
  35.       Caption         =   "Pit"
  36.       Height          =   255
  37.       Index           =   12
  38.       Left            =   0
  39.       TabIndex        =   13
  40.       Top             =   4320
  41.       Width           =   2055
  42.    End
  43.    Begin VB.OptionButton optSurface 
  44.       Caption         =   "Canyons"
  45.       Height          =   255
  46.       Index           =   11
  47.       Left            =   0
  48.       TabIndex        =   12
  49.       Top             =   3960
  50.       Width           =   2055
  51.    End
  52.    Begin VB.OptionButton optSurface 
  53.       Caption         =   "Hill and Hole"
  54.       Height          =   255
  55.       Index           =   10
  56.       Left            =   0
  57.       TabIndex        =   11
  58.       Top             =   3600
  59.       Width           =   2055
  60.    End
  61.    Begin VB.OptionButton optSurface 
  62.       Caption         =   "Monkey Saddle"
  63.       Height          =   255
  64.       Index           =   9
  65.       Left            =   0
  66.       TabIndex        =   10
  67.       Top             =   3240
  68.       Width           =   2055
  69.    End
  70.    Begin VB.OptionButton optSurface 
  71.       Caption         =   "Splash"
  72.       Height          =   255
  73.       Index           =   0
  74.       Left            =   0
  75.       TabIndex        =   9
  76.       Top             =   0
  77.       Value           =   -1  'True
  78.       Width           =   2055
  79.    End
  80.    Begin VB.OptionButton optSurface 
  81.       Caption         =   "Mounds"
  82.       Height          =   255
  83.       Index           =   1
  84.       Left            =   0
  85.       TabIndex        =   8
  86.       Top             =   360
  87.       Width           =   2055
  88.    End
  89.    Begin VB.OptionButton optSurface 
  90.       Caption         =   "Bowl"
  91.       Height          =   255
  92.       Index           =   2
  93.       Left            =   0
  94.       TabIndex        =   7
  95.       Top             =   720
  96.       Width           =   2055
  97.    End
  98.    Begin VB.OptionButton optSurface 
  99.       Caption         =   "Ridges"
  100.       Height          =   255
  101.       Index           =   3
  102.       Left            =   0
  103.       TabIndex        =   6
  104.       Top             =   1080
  105.       Width           =   2055
  106.    End
  107.    Begin VB.OptionButton optSurface 
  108.       Caption         =   "Randomized Ridges"
  109.       Height          =   255
  110.       Index           =   4
  111.       Left            =   0
  112.       TabIndex        =   5
  113.       Top             =   1440
  114.       Width           =   2055
  115.    End
  116.    Begin VB.OptionButton optSurface 
  117.       Caption         =   "Hemisphere"
  118.       Height          =   255
  119.       Index           =   5
  120.       Left            =   0
  121.       TabIndex        =   4
  122.       Top             =   1800
  123.       Width           =   2055
  124.    End
  125.    Begin VB.OptionButton optSurface 
  126.       Caption         =   "Holes"
  127.       Height          =   255
  128.       Index           =   6
  129.       Left            =   0
  130.       TabIndex        =   3
  131.       Top             =   2160
  132.       Width           =   2055
  133.    End
  134.    Begin VB.OptionButton optSurface 
  135.       Caption         =   "Cone"
  136.       Height          =   255
  137.       Index           =   7
  138.       Left            =   0
  139.       TabIndex        =   2
  140.       Top             =   2520
  141.       Width           =   2055
  142.    End
  143.    Begin VB.OptionButton optSurface 
  144.       Caption         =   "Saddle"
  145.       Height          =   255
  146.       Index           =   8
  147.       Left            =   0
  148.       TabIndex        =   1
  149.       Top             =   2880
  150.       Width           =   2055
  151.    End
  152.    Begin VB.PictureBox picCanvas 
  153.       AutoRedraw      =   -1  'True
  154.       Height          =   5295
  155.       Left            =   2160
  156.       ScaleHeight     =   349
  157.       ScaleMode       =   3  'Pixel
  158.       ScaleWidth      =   461
  159.       TabIndex        =   0
  160.       Top             =   0
  161.       Width           =   6975
  162.    End
  163. Attribute VB_Name = "frmSurface2"
  164. Attribute VB_GlobalNameSpace = False
  165. Attribute VB_Creatable = False
  166. Attribute VB_PredeclaredId = True
  167. Attribute VB_Exposed = False
  168. Option Explicit
  169. ' Location of viewing eye.
  170. Private EyeR As Single
  171. Private EyeTheta As Single
  172. Private EyePhi As Single
  173. Private Const Dtheta = PI / 20
  174. Private Const Dphi = PI / 20
  175. Private Const Dr = 1
  176. ' Location of focus point.
  177. Private Const FocusX = 0#
  178. Private Const FocusY = 0#
  179. Private Const FocusZ = 0#
  180. Private Projector(1 To 4, 1 To 4) As Single
  181. Private TheGrid As RefinedGrid3d
  182. Private Enum SurfaceTypes
  183.     surface_Splash = 0
  184.     surface_Mounds = 1
  185.     surface_Bowl = 2
  186.     surface_Ridges = 3
  187.     surface_RandomRidges = 4
  188.     surface_Hemisphere = 5
  189.     surface_Holes = 6
  190.     surface_Cone = 7
  191.     surface_Saddle = 8
  192.     surface_MonkeySaddle = 9
  193.     surface_HillAndHole = 10
  194.     surface_Canyons = 11
  195.     surface_Pit = 12
  196.     surface_Volcano = 13
  197. End Enum
  198. Private SelectedSurface As SurfaceTypes
  199. Private SphereRadius As Single
  200. Private Const Amplitude1 = 0.25
  201. Private Const Period1 = 2 * PI / 4
  202. Private Const Amplitude2 = 1
  203. Private Const Period2 = 2 * PI / 16
  204. Private Const Amplitude3 = 2
  205. Private Const Xmin = -5
  206. Private Const Zmin = -5
  207. ' Project and display the data.
  208. Private Sub DrawData(pic As Object)
  209. Dim X As Single
  210. Dim Y As Single
  211. Dim Z As Single
  212. Dim S(1 To 4, 1 To 4) As Single
  213. Dim T(1 To 4, 1 To 4) As Single
  214. Dim ST(1 To 4, 1 To 4) As Single
  215. Dim PST(1 To 4, 1 To 4) As Single
  216.     MousePointer = vbHourglass
  217.     DoEvents
  218.     ' Make the data.
  219.     CreateData
  220.     ' Scale and translate so it looks OK in pixels.
  221.     m3Scale S, 35, -35, 1
  222.     m3Translate T, 230, 175, 0
  223.     m3MatMultiplyFull ST, S, T
  224.     m3MatMultiplyFull PST, Projector, ST
  225.     ' Transform the points.
  226.     TheGrid.ApplyFull PST
  227.     ' Prevent overflow errors when drawing lines
  228.     ' too far out of bounds.
  229.     On Error Resume Next
  230.     ' Display the data.
  231.     pic.Cls
  232.     TheGrid.Draw pic
  233.     pic.Refresh
  234.     MousePointer = vbDefault
  235.     picCanvas.SetFocus
  236. End Sub
  237. ' Return the Y coordinate for these X and
  238. ' Z coordinates.
  239. Private Function YValue(ByVal X As Single, ByVal Z As Single)
  240. Dim x1 As Single
  241. Dim z1 As Single
  242. Dim x2 As Single
  243. Dim z2 As Single
  244. Dim D As Single
  245.     Select Case SelectedSurface
  246.         Case surface_Splash
  247.             D = Sqr(X * X + Z * Z)
  248.             YValue = Amplitude1 * Cos(3 * D)
  249.         Case surface_Mounds
  250.             YValue = Amplitude1 * (Cos(Period1 * X) + Cos(Period1 * Z))
  251.         Case surface_Bowl
  252.             YValue = 0.2 * (X * X + Z * Z) - 5#
  253.         Case surface_Ridges
  254.             YValue = Amplitude2 * Cos(Period2 * X) + Amplitude3 * Cos(Period1 * Z) / (Abs(Z) / 3 + 1)
  255.         Case surface_RandomRidges
  256.             YValue = Amplitude2 * Cos(Period2 * X) + Amplitude3 * Cos(Period1 * Z) / (Abs(Z) / 3 + 1) + Amplitude1 * Rnd
  257.         Case surface_Hemisphere
  258.             D = X * X + Z * Z
  259.             If D >= SphereRadius Then
  260.                 YValue = 0
  261.             Else
  262.                 YValue = Sqr(SphereRadius - D)
  263.             End If
  264.         Case surface_Holes
  265.             x1 = (X + Xmin / 2)
  266.             z1 = (Z + Xmin / 2)
  267.             x2 = (X - Xmin / 2)
  268.             z2 = (Z - Xmin / 2)
  269.             YValue = Amplitude3 - _
  270.                 1 / (x1 * x1 + z1 * z1 + 0.1) - _
  271.                 1 / (x2 * x2 + z1 * z1 + 0.1) - _
  272.                 1 / (x1 * x1 + z2 * z2 + 0.1) - _
  273.                 1 / (x2 * x2 + z2 * z2 + 0.1)
  274.         Case surface_Cone
  275.             D = 2 * (Amplitude3 - Sqr(X * X + Z * Z))
  276.             If D < -Amplitude3 Then D = -Amplitude3
  277.             YValue = D
  278.         Case surface_Saddle
  279.             YValue = (X * X - Z * Z) / 10
  280.         Case surface_MonkeySaddle
  281.             x1 = 1.5 * X
  282.             z1 = 1.5 * Z
  283.             YValue = (x1 * x1 * x1 / 3 - x1 * z1 * z1) / 50
  284.         Case surface_HillAndHole
  285.             YValue = -5 * X / (X * X + Z * Z + 1)
  286.         Case surface_Canyons
  287.             YValue = Sin(X * 1.5) * Z * Z * Z / 30
  288.         Case surface_Pit
  289.             YValue = -3 + (X * X + Z * Z) / 10 + Sin(2 * Sqr(X * X + Z * Z)) / 2
  290.         Case surface_Volcano
  291.             YValue = -Abs(X * X + Z * Z - 9) / 10
  292.     End Select
  293. End Function
  294. Private Sub optSurface_Click(Index As Integer)
  295.     SelectedSurface = Index
  296.     DrawData picCanvas
  297. End Sub
  298. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  299.     Select Case KeyCode
  300.         Case vbKeyLeft
  301.             EyeTheta = EyeTheta - Dtheta
  302.         
  303.         Case vbKeyRight
  304.             EyeTheta = EyeTheta + Dtheta
  305.         
  306.         Case vbKeyUp
  307.             EyePhi = EyePhi - Dphi
  308.         
  309.         Case vbKeyDown
  310.             EyePhi = EyePhi + Dphi
  311.                 
  312.         Case Else
  313.             Exit Sub
  314.     End Select
  315.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  316.     DrawData picCanvas
  317. End Sub
  318. Private Sub Form_KeyPress(KeyAscii As Integer)
  319.     Select Case KeyAscii
  320.         Case Asc("+")
  321.             EyeR = EyeR + Dr
  322.         
  323.         Case Asc("-")
  324.             EyeR = EyeR - Dr
  325.         
  326.         Case Else
  327.             Exit Sub
  328.     End Select
  329.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  330.     DrawData picCanvas
  331. End Sub
  332. Private Sub Form_Load()
  333.     ' Initialize the eye position.
  334.     EyeR = 10
  335.     EyeTheta = PI * 0.2
  336.     EyePhi = PI * 0.1
  337.     ' Initialize the projection transformation.
  338.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  339.     ' Project and draw the data.
  340.     Me.Show
  341.     DrawData picCanvas
  342. End Sub
  343. ' Create the surface.
  344. Private Sub CreateData()
  345. Const Subdivisions = 3
  346. Const MajorDx = 0.6
  347. Const MajorDz = 0.6
  348. Const MinorDx = MajorDx / Subdivisions
  349. Const MinorDz = MajorDz / Subdivisions
  350. Const NumX = -2 * Xmin / MajorDx
  351. Const NumZ = -2 * Zmin / MajorDz
  352. Dim i As Integer
  353. Dim j As Integer
  354. Dim k As Integer
  355. Dim X As Single
  356. Dim Y As Single
  357. Dim Z As Single
  358. Dim x1 As Single
  359. Dim y1 As Single
  360. Dim z1 As Single
  361. Dim x2 As Single
  362. Dim y2 As Single
  363. Dim z2 As Single
  364. Dim pline As Polyline3d
  365.     Set TheGrid = New RefinedGrid3d
  366.     SphereRadius = (Xmin + 3 * MajorDx) * (Xmin + 3 * MajorDx)
  367.     ' Make polylines parallel to the X axis.
  368.     X = Xmin
  369.     For i = 1 To NumX
  370.         Set pline = New Polyline3d
  371.         z1 = Zmin
  372.         ' Get the starting point.
  373.         y1 = YValue(X, z1)
  374.         For j = 1 To NumZ - 1
  375.             For k = 1 To Subdivisions
  376.                 z2 = z1 + MinorDz
  377.                 y2 = YValue(X, z2)
  378.                 pline.AddSegment X, y1, z1, X, y2, z2
  379.                 y1 = y2
  380.                 z1 = z2
  381.             Next k
  382.         Next j
  383.         TheGrid.Polylines.Add pline
  384.         X = X + MajorDx
  385.     Next i
  386.     ' Make polylines parallel to the Z axis.
  387.     Z = Zmin
  388.     For i = 1 To NumZ
  389.         Set pline = New Polyline3d
  390.         x1 = Xmin
  391.         ' Get the starting point.
  392.         y1 = YValue(x1, Z)
  393.         For j = 1 To NumX - 1
  394.             For k = 1 To Subdivisions
  395.                 x2 = x1 + MinorDx
  396.                 y2 = YValue(x2, Z)
  397.                 pline.AddSegment x1, y1, Z, x2, y2, Z
  398.                 y1 = y2
  399.                 x1 = x2
  400.             Next k
  401.         Next j
  402.         TheGrid.Polylines.Add pline
  403.         Z = Z + MajorDz
  404.     Next i
  405. End Sub
  406.